home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / OMENU / OMENU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-10  |  27KB  |  856 lines
  1. UNIT OMENU;
  2. { DEFINE FGI}                   {Define FGI if using the Fastgraph
  3.                                  routines from Ted Gruber Software.
  4.                                  Otherwise, use the Borland BGI }
  5. {$A+     + Align Data on}
  6. {$B-     - Boolean Eval short}
  7. {$D+     + Debug info on}
  8. {$E+     + 8087 Emulation on}
  9. {$F+     + Force far calls on}
  10. {$G+     + Generate 286 code}
  11. {$I+     + IO checking on}
  12. {$L+     + Local symbols on}
  13. {$N-     - Numeric Processing off}
  14. {$O-     - Overlays off}
  15. {$R+     + Range checks on}
  16. {$S+     + Stack checks on}
  17. {$V-     - Relaxed String checks}
  18. {$X+     + Extended Syntax on}
  19.  
  20. interface
  21. const
  22.     MaxItems              = 25;                 { max items on a menu }
  23.     ParseDelimiter        : char    = '|';
  24.     ShadowOn              = true;               { use shadow booleans }
  25.     ShadowOff             = false;
  26.     UserShadWt            : integer =  5;       { default shadow width }
  27.     BorderOn              = true;               { use border booleans }
  28.     BorderOff             = false;
  29.     black                 : integer =  0;
  30.     blue                  : integer =  1;
  31.     green                 : integer =  2;
  32.     cyan                  : integer =  3;
  33.     red                   : integer =  4;
  34.     magenta               : integer =  5;
  35.     brown                 : integer =  6;
  36.     gray                  : integer =  7;
  37.     dgray                 : integer =  8;
  38.     lblue                 : integer =  9;
  39.     lgreen                : integer = 10;
  40.     lcyan                 : integer = 11;
  41.     lred                  : integer = 12;
  42.     lmagenta              : integer = 13;
  43.     yellow                : integer = 14;
  44.     white                 : integer = 15;
  45.  
  46.  
  47. {The following 8 procedures are not objects ! }
  48.   procedure GraphInit;                { init graphics environment }
  49.   procedure GraphDone;                { return to text mode }
  50.   procedure GGotoxy(x,y:integer);     { gotoxy }
  51.   procedure GWriteXy(x,y:integer;s:string;bg,fg:integer);
  52.             {write at xy using text coordinates}
  53.   procedure GWritePXy(x,y:integer;s:string;bg,fg:integer);
  54.             {Write at xy using pixel coordinates (640x480}
  55.   procedure GWriteXyClip(x,y:integer;s:string;Bg,Fg,clp:integer);
  56.             {write at text-xy and truncate string to fit }
  57.   procedure GClrScr(color:integer);
  58.             { clear the screen in any color }
  59.  
  60. type
  61.    TMenuParms = record                  { record to hold parms for }
  62.      Menu,x1,y1,x2,y2,Nbg,NFg,HBg,HFg,  { each menu you set up }
  63.           px1,px2,py1,py2,
  64.        Border,shadow,NumItems,Highlight: integer;
  65.      BordOn,ShadOn                     : boolean;
  66.      AStr                              : string;
  67.      end;
  68.  
  69.   Ohmenu = object
  70.     onscreen                           : boolean;  {is menu now on screen?}
  71.     MenuNumber                         : integer;
  72.     MenuParms                          : TMenuParms;
  73.     TArray : array[1..MaxItems] of string[105];    {up to 25 items}
  74.     Buffer                             : pointer;  {ptr to hold image buffer}
  75.     Buffersize                         : longint;  {size of image buffer}
  76.     Result                             : integer;  {user keypress Result }
  77.     Choice                             : integer;  {user menu choice }
  78.     BuffW,BuffH                        : integer;  {buffersize}
  79.     EraseOK                            : boolean;  {can erase menu?}
  80.     ShadWt                             : integer;  {shadow width}
  81.  
  82.     constructor Init;
  83.     destructor  Done;
  84.     procedure   ParseText;                         { get the menu items }
  85.     procedure   UseMenu(m:integer);    virtual;    { items delimited by '|' }
  86.     procedure   ShowMenu;              virtual;    { called from UseMenu }
  87.     procedure   EraseMenu;                         { erase, free buffer }
  88.     procedure   MakeBuffer;                        { save screen on heap }
  89.     function    GetChoice : integer;               { returns user choice }
  90.     end;
  91.   OVMenu =  object (OHMenu)
  92.     constructor Init;
  93.     procedure   UseMenu(m:integer);   virtual;
  94.     procedure   ShowMenu;             virtual;
  95.    end;
  96.  
  97.  
  98.   OHVMenu = object
  99.     HVResult    : longint;
  100.     HResult     : shortint;
  101.     VResult     : shortint;
  102.     VertMenus   : shortint;
  103.     MenuArray   : array[0..25] of TMenuparms;
  104.     HMenu       : OHMenu;
  105.     VMenu       : OVMenu;
  106.     constructor Init;
  107.     destructor  done;
  108.     procedure   SetHorItems(
  109.                 x1,y1,x2,y2,Nbg,NFg,HBg,HFg,
  110.                 Border,shadow,NumItems,Highlight:integer;
  111.                 BordOn,ShadOn:boolean;
  112.                 AStr:string);
  113.     procedure   PutHParms(num:integer);
  114.     procedure   SetVerItems(
  115.                 menu,x1,y1,x2,y2,Nbg,NFg,HBg,HFg,
  116.                 Border,shadow,NumItems,Highlight:integer;
  117.                 BordOn,ShadOn:boolean;
  118.                 AStr:string);
  119.     procedure   PutVParms(num:integer);
  120.     function    GetHResult:shortint;               virtual;
  121.     function    GetVResult:shortint;               virtual;
  122.     function    GetHVResult:longint;               virtual;
  123.     function    GetHChoice:shortint;               virtual;
  124.     function    GetVChoice:shortint;               virtual;
  125.     function    GetHVChoice:longint;               virtual;
  126.     procedure   UseMenu;                           virtual;
  127.     function    MenuResult(EraseH,EraseV:boolean):integer;
  128.     end;
  129.  
  130. {****************************** implementation *************************}
  131. implementation
  132. {$IFDEF FGI}
  133. uses fgmain, fgbitmap, fgmisc;
  134. {$ELSE}
  135. uses graph,crt;
  136. {$ENDIF}
  137. const
  138.     Hidden = 1;                                 { vga hidden page (partial) }
  139.     Active = 0;                                 { vga active visual page }
  140.     MonoGraphicMode       = 17;                 { 640x480, mono   }
  141.     ColorGraphicMode      = 18;                 { 640x480, color  }
  142.     NoGoodGraphicMode     = 15;
  143.     CurrentGraphicMode    : integer =   0;
  144.     CellHt                : integer =  16;      { Cell height, VGA modes 17,18 }
  145.     CellWt                : integer =   8;      { Cell width,  VGA modes 17,18 }
  146.     UpArrow               = 72;
  147.     DnArrow               = 80;
  148.     LfArrow               = 75;
  149.     RtArrow               = 77;
  150.     Enter                 = 13;
  151.     Escape                = 27;
  152.     Backspace             = 08;
  153.     Tab                   = 09;
  154.  
  155.     oldmode               : integer = 0;
  156.     UsingColor            : boolean = false;
  157.     GraphInitialized      : boolean = false;
  158.  
  159.   procedure J_SetColor(x:word);
  160.   begin
  161.     {$IFDEF FGI} fg_setcolor(x);
  162.     {$ELSE}      setcolor(x);
  163.                  SetFillStyle(solidfill,x);
  164.     {$ENDIF}
  165.     end;
  166.   function  J_GetColor:integer;
  167.   begin
  168.     {$IFDEF FGI} J_GetColor:=fg_GetColor;
  169.     {$ELSE} j_GetColor:=GetColor;
  170.     {$ENDIF}
  171.     end;
  172.   procedure J_Box(x1,x2,y1,y2:integer);
  173.   begin
  174.     {$IFDEF FGI}
  175.     fg_box(x1,x2,y1,y2);
  176.     {$ELSE}
  177.     rectangle(x1,y1,x2,y2);
  178.     {$ENDIF}
  179.     end;
  180.   procedure J_Rect(x1,x2,y1,y2:integer);
  181.   begin
  182.     {$IFDEF FGI}
  183.     fg_rect(x1,x2,y1,y2);
  184.     {$ELSE}
  185.     bar(x1,y1,x2,y2);
  186.     {$ENDIF}
  187.     end;
  188.   procedure J_GetKey(var bt1,bt2:byte);
  189.   begin
  190.     {$IFDEF FGI}
  191.     fg_getkey(bt1,bt2);
  192.     {$ELSE}
  193.     bt1:=0;
  194.     bt2:=0;
  195.     while not keypressed do;
  196.     bt1:=byte(readkey);
  197.     if bt1=0 then bt2:=byte(readkey);
  198.     {$ENDIF}
  199.     end;
  200.   procedure J_move(xx,yy:integer);
  201.   begin
  202.     {$IFDEF FGI} fg_move(xx,yy);
  203.     {$ELSE}      moveto(xx,yy);
  204.     {$ENDIF}
  205.     end;
  206.   procedure J_DrawX(xx,yy:integer);
  207.   begin
  208.     {$IFDEF FGI} fg_drawx(xx,yy);
  209.     {$ELSE}
  210.     SetWriteMode(XORPut);
  211.     LineTo(xx,yy);
  212.     SetWriteMode(CopyPut);
  213.     {$ENDIF}
  214.     end;
  215.     procedure j_locate(yy,xx:integer);
  216.     begin
  217.       {$IFDEF FGI}
  218.       fg_locate(yy,xx);
  219.       {$ELSE}
  220.       gotoxy(xx+1,yy+1);
  221.       {$ENDIF}
  222.       end;
  223.  
  224.   function HighX:integer;
  225.     begin
  226.     {$IFDEF FGI}
  227.     HighX:=fg_GetMaxx;
  228.     {$ELSE}
  229.     HighX:=GetMaxx;
  230.     {$ENDIF}
  231.     end;
  232.  
  233.   function HighY:integer;
  234.     begin
  235.     {$IFDEF FGI}
  236.     HighY:=fg_GetMaxy;
  237.     {$ELSE}
  238.     HighY:=GetMaxy;
  239.     {$ENDIF}
  240.     end;
  241.  
  242.   constructor OHmenu.Init;
  243.     var i:integer;
  244.     begin
  245.       GraphInit;
  246.       with menuparms do begin
  247.         x1:=0;   x2:=80;   y1:=0;   y2:=1;
  248.         NBg      := white; NFg      := black;
  249.         HBg      := black; HFg      := white;
  250.         Border   := black; Shadow   := white;
  251.         BordOn := true;  ShadOn := false;
  252.         BufferSize:=0;
  253.         NumItems :=0;
  254.         Highlight:=0;
  255.         EraseOK:=true;
  256.         ShadWt:=UserShadWt;
  257.         end;
  258.       Result     :=0;      onscreen := false;
  259.       for i := 1 to MaxItems do TArray[i]:='';
  260.     end;
  261.   constructor OVMenu.Init;
  262.     begin
  263.       inherited init;
  264.       MenuParms.ShadOn:=true;
  265.     end;
  266.  
  267.   destructor OHmenu.done;
  268.     var x:integer;
  269.     begin
  270.       Erasemenu;
  271.     end;
  272.  
  273.   procedure OHmenu.UseMenu(M:integer);
  274.     var
  275.       tx1,tx2,ty1,ty2 : integer;
  276.       bg,fg,i,j,k,L,old : integer;
  277.       b1,b2 : byte;
  278.     label loop;
  279.     begin
  280.       if onscreen then EraseMenu;
  281.       MenuNumber:=m;
  282.       ParseText;
  283.       showmenu;
  284.       old:=j_GetColor;
  285.       Loop:
  286.         if MenuParms.Highlight<1 then
  287.            MenuParms.Highlight:=MenuParms.NumItems;
  288.         if MenuParms.Highlight>MenuParms.NumItems then
  289.            MenuParms.Highlight:=1;
  290.       for i := 1 to MenuParms.NumItems do
  291.       begin
  292.         if MenuParms.Highlight=i
  293.           then begin bg:=MenuParms.HBg;fg:=MenuParms.HFg; end
  294.           else begin bg:=MenuParms.NBg;fg:=MenuParms.NFg; end;
  295.  
  296.         k:=0;
  297.         for j:= 1 to i do begin
  298.           L:=length(tarray[j]);
  299.           k:=k+L;
  300.           end;
  301.         tx1:=   (MenuParms.x1+k-length(tarray[i]))*CellWt;
  302.         tx2:=   (MenuParms.x1+k)*CellWt;
  303.         ty1:=   MenuParms.y1*CellHt+2;
  304.         ty2:=   MenuParms.y2*CellHt-2;
  305.         J_SetColor(Bg);
  306.         J_Rect(tx1,tx2,ty1,ty2);
  307.         GWriteXY(tx1 div CellWt,MenuParms.y1 div cellht, tarray[i],bg,fg);
  308.         j_setcolor(Old);
  309.         end;
  310.       j_Getkey(b1,b2);
  311.       if b2 = LfArrow then dec(MenuParms.highlight);
  312.       if b2 = RtArrow then inc(MenuParms.highlight);
  313.       if b2 in [Rtarrow,Lfarrow] then goto loop;
  314.       Result:=0;
  315.       Choice:=0;
  316.       if b1 = Enter then begin
  317.         Choice:=MenuParms.Highlight;
  318.         Result:=Enter;
  319.         end;
  320.       if b2 = DnArrow then begin
  321.         Result:=DnArrow;
  322.         Choice:=MenuParms.Highlight;
  323.         end;
  324.       if b1 = Escape  then Result:=Escape;
  325.     end;
  326.  
  327. procedure OVMenu.UseMenu(m:integer);
  328.     var
  329.       bg,fg,i,old : integer;
  330.       b1,b2 : byte;
  331.     label loop;
  332.     begin
  333.       if onscreen then EraseMenu;
  334.       MenuNumber:=m;
  335.       ParseText;
  336.       showmenu;
  337.       old:=j_getcolor;
  338.       Loop:
  339.         if MenuParms.Highlight<1 then MenuParms.Highlight:=MenuParms.NumItems;
  340.         if MenuParms.Highlight>MenuParms.NumItems then MenuParms.Highlight:=1;
  341.       for i := 1 to MenuParms.NumItems do
  342.       begin
  343.         if MenuParms.Highlight=i
  344.           then begin bg:=MenuParms.HBg;fg:=MenuParms.HFg; end
  345.           else begin bg:=MenuParms.NBg;fg:=MenuParms.NFg; end;
  346.  
  347.         j_SetColor(Bg);
  348.         j_rect(MenuParms.px1,
  349.                MenuParms.px2,
  350.                i*CellHt  ,
  351.                i*CellHt+CellHt-1);
  352.         GWriteXYClip(MenuParms.x1,MenuParms.y1+i-1,tarray[i],bg,fg,MenuParms.x2-MenuParms.x1);
  353.         j_setcolor(old);
  354.         end;
  355.         j_GetKey(b1,b2);
  356.       if b2 = UpArrow then dec(MenuParms.highlight);
  357.       if b2 = DnArrow then inc(MenuParms.highlight);
  358.       if b2 in [Uparrow,Dnarrow] then goto loop;
  359.       Result:=0;
  360.       Choice:=0;
  361.       if b1 = Enter then begin
  362.         Result:=Enter;
  363.         Choice:=MenuParms.Highlight;
  364.         end;
  365.       if b2 = LfArrow then Result:=LfArrow;
  366.       if b2 = RtArrow then Result:=RtArrow;
  367.       if b1 = Escape  then Result:=Escape;
  368.     end;
  369.  
  370.  
  371.   procedure OHmenu.ShowMenu;
  372.     var
  373.       old,i,x  : integer;
  374.     begin
  375.       MakeBuffer;
  376.       old:=j_GetColor;
  377.       With MenuParms do begin
  378.         j_setcolor(NBg);
  379.         j_rect(px1,px2,py1,py2);
  380.         if BordOn then begin
  381.           j_setcolor(Border);
  382.           j_Box(px1,px2,py1,py2);
  383.           end;
  384.  
  385.       {xor a shadow}
  386.         if ShadOn then begin
  387.           j_setcolor(Shadow);
  388.           for i := 1 to ShadWt do begin
  389.             if (px2+ShadWt) <=HighX then
  390.             if (py2+ShadWt) <=HighY then
  391.             begin
  392.               j_move(px2+i,py1+i);
  393.               j_drawx(px2+i, py2+i);
  394.               j_move(px1+i, py2+i);
  395.               j_drawx(px2+i-1,py2+i);
  396.               end; {if px2+shad...}
  397.             end; {for i}
  398.           end; {if shadon }
  399.         end; { with menuparms do }
  400.       j_setcolor(old);
  401.       onscreen:=true;
  402.       end;
  403.  
  404.     procedure OHMenu.EraseMenu;
  405.       var x:integer;
  406.       begin
  407.       if not onscreen then exit;
  408.       {$IFDEF FGI}
  409.       fg_putblock(Buffer,
  410.         MenuParms.px1,
  411.         MenuParms.px2+ShadWt,
  412.         MenuParms.py1,
  413.         MenuParms.py2+ShadWt);
  414.       {$ELSE}
  415.       putimage(MenuParms.px1,MenuParms.py1,buffer^,copyput);
  416.       {$ENDIF}
  417.       FreeMem(buffer,BufferSize);
  418.       onscreen:=false;
  419.       end; {proc}
  420.   procedure GraphInit;
  421.     var i, result, Trymode,
  422.     BGIDriver, BGIMode : integer;
  423.     begin
  424.       if GraphInitialized then exit;
  425.       CurrentGraphicMode:=0;
  426.       {$IFDEF FGI}
  427.       oldmode:=fg_getmode;
  428.       for TryMode:=ColorGraphicMode downto NoGoodGraphicMode do
  429.       begin
  430.         Result:=Fg_Testmode(TryMode,1);
  431.         if Result=1 then break;                         { 1 means success }
  432.         end;
  433.       CurrentGraphicMode:=TryMode;
  434.       if CurrentGraphicMode=NoGoodGraphicMode then
  435.       begin
  436.         writeln;
  437.         writeln('Could not initialize graphic mode ',ColorGraphicMode,' or ',
  438.                  MonoGraphicMode,'.  A 640x480 VGA mode is required.');
  439.         end;
  440.       UsingColor:=(CurrentGraphicMode=ColorGraphicMode);
  441.       Fg_Setmode(CurrentGraphicMode);
  442.       fg_setpage(active);
  443.       fg_sethpage(hidden);
  444.       {$ELSE}
  445.       BGIDriver:=Detect;
  446.       InitGraph(BgiDriver,BgiMode,'');
  447.       UsingColor:=true;
  448.       directvideo:=false;
  449.       {$ENDIF}
  450.       if not UsingColor then
  451.       begin
  452.         dgray    :=  0;
  453.         white    :=  1;
  454.         blue     :=  0;
  455.         green    :=  0;
  456.         cyan     :=  0;
  457.         red      :=  0;
  458.         magenta  :=  0;
  459.         brown    :=  0;
  460.         gray     :=  0;
  461.         lblue    :=  0;
  462.         lgreen   :=  0;
  463.         lcyan    :=  0;
  464.         lred     :=  0;
  465.         lmagenta :=  0;
  466.         yellow   :=  1;
  467.         end;
  468.     GraphInitialized:=true;
  469.     end; { proc }
  470.  
  471.  
  472.   procedure GraphDone;
  473.     begin
  474.       {$IFDEF FGI}
  475.       fg_setmode(oldmode);
  476.       fg_reset;
  477.       {$ELSE}
  478.       Closegraph;
  479.       RestoreCRTMode;
  480.       {$ENDIF}
  481.     end;
  482.  
  483.   procedure GGotoxy(x,y:integer);
  484.     begin
  485.       {$IFDEF FGI}
  486.       fg_move(x*CellWt,y*CellHt+CellHt);
  487.       {$ELSE}
  488.       moveto(x*CellWt,Y*CellHt+CellHt);
  489.       {$ENDIF}
  490.     end;
  491.   procedure GWriteXy(x,y:integer;s:string;bg,fg:integer);
  492.     begin
  493.       J_locate(y,x);
  494.       j_setcolor(fg);
  495.       {$IFDEF FGI}
  496.       fg_text(s,length(s));
  497.       {$ELSE}
  498.       J_setcolor(bg);
  499.       {bar(x*CellWt,y*CellHt,(x+length(s))*CellWt,y*CellHt+CellHt);}
  500.       textattr:=textattr or $80;
  501.       J_setcolor(fg);
  502.       j_locate(y,x);
  503.       write(s);
  504.       textattr:=textattr or $7f;
  505.       {$ENDIF}
  506.       end;
  507.   procedure GWritePXy(x,y:integer;s:string;bg,fg:integer);
  508.     begin
  509.       {$IFDEF FGI}
  510.       fg_move(x,y);
  511.       j_setcolor(fg);
  512.       fg_text(s,length(s));
  513.       {$ELSE}
  514.       moveto(x,y);
  515.       gotoxy(x*CellWt,y*CellHt);
  516.       j_setcolor(fg);
  517.       textattr:=textattr or $80;
  518.       Write(s);
  519.       textattr:=textattr or $7f;
  520.       {$ENDIF}
  521.       end;
  522.   procedure GWriteXyClip(x,y:integer;s:string;bg,fg,clp:integer);
  523.     begin
  524.       j_locate(y,x);
  525.       j_setcolor(fg);
  526.       if length(s)<clp then clp:=length(s);
  527.       {$IFDEF FGI}
  528.       fg_text(s,clp);
  529.       {$ELSE}
  530.       s:=copy(s,1,clp);
  531.       textattr:=textattr or $80;
  532.       setcolor(bg);
  533.       {bar(x*CellWt,y*CellHt,(x+clp)*CellWt,y*CellHt+CellHt);}
  534.       setcolor(fg);
  535.       write(s);
  536.       textattr:=textattr or $7f;
  537.       {$ENDIF}
  538.       end;
  539.   procedure GClrScr(color:integer);
  540.     var old : integer;
  541.     begin
  542.       old:=j_getcolor;
  543.       j_setcolor(color);
  544.       j_rect(0,HighX,0,HighY);
  545.  
  546.       j_setcolor(old);
  547.       GGotoxy(0,0);
  548.       end;
  549.  
  550.   procedure OHmenu.ParseText;
  551.     var i,j,index: integer;
  552.         Bstr,Cstr,DStr: string[105];
  553.     begin
  554.       {parses from ParmStr[0]}
  555.       CStr:=MenuParms.AStr; index:=0; DStr:='';
  556.       if CStr[length(Cstr)]<>ParseDelimiter then CStr:=CStr+ParseDelimiter;
  557.       for i := 1 to length(MenuParms.AStr) do
  558.         if MenuParms.AStr[i]<>ParseDelimiter then DStr:=DStr+MenuParms.AStr[i];
  559.       for i := 1 to MaxItems do begin
  560.         {parse text }
  561.         j:=pos(ParseDelimiter,CStr);
  562.         if j>0 then begin
  563.           BStr:=copy(Cstr,1,j-1);
  564.           CStr:=copy(Cstr,j+1,length(CStr)-j);
  565.           inc(index);
  566.           TArray[index]:=BStr;
  567.           MenuParms.NumItems:=Index;
  568.           end;
  569.         end;
  570.       end; {proc}
  571.  
  572.   procedure OHmenu.MakeBuffer;
  573.     begin
  574.       BuffW:=MenuParms.pX2+ShadWt -MenuParms.px1 +1;
  575.       BuffH:=MenuParms.py2+ShadWt -MenuParms.py1 +1;
  576.       {$IFDEF FGI}
  577.       if BuffW>(HighX+1) then BuffW:=(HighX+1);
  578.       if BuffH>(HighY+1) then BuffH:=(HighY+1);
  579.       Buffersize :=fg_imagesiz(BuffW,BuffH);
  580.       {$ELSE}
  581.       Buffersize :=imagesize(MenuParms.px1,Menuparms.py1,
  582.                              MenuParms.px2,MenuParms.py2);
  583.       {$ENDIF}
  584.  
  585.       if MaxAvail < Buffersize then begin
  586.         GraphDone;
  587.         writeln('Couldnt allocate memory for image buffer.');
  588.         end;
  589.       GetMem(buffer,Buffersize);
  590.       {$IFDEF FGI}
  591.       fg_getblock(Buffer,
  592.         MenuParms.px1,
  593.         MenuParms.px2+ShadWt,
  594.         MenuParms.py1,
  595.         MenuParms.py2+ShadWt);
  596.       {$ELSE}
  597.       GetImage(MenuParms.px1,
  598.                MenuParms.py1,
  599.                MenuParms.px2+ShadWt,
  600.                MenuParms.py2+ShadWt, buffer^);
  601.       {$ENDIF}
  602.       end; {proc}
  603.  
  604.   function    OHMenu.GetChoice : integer;
  605.     begin
  606.       GetChoice:=choice;
  607.     end;
  608.  
  609.   procedure OVMenu.ShowMenu;
  610.     var
  611.       old,i  : integer;
  612.     begin
  613.       MakeBuffer;
  614.       old:=j_getcolor;
  615.       With MenuParms do begin
  616.         j_setcolor(NBg);
  617.         j_rect(px1,px2,py1,py2);
  618.         if BordOn then begin
  619.           j_setcolor(Border);
  620.           j_box(px1,px2,py1,py2);
  621.           end;
  622.         j_setcolor(shadow);
  623.         {xor a shadow}
  624.         if ShadOn then for i := 1 to ShadWt do begin
  625.           j_move(px2+i,py1+i);
  626.           j_drawx(px2+i, py2+i);
  627.           j_move(px1+i,  py2+i);
  628.           j_drawx(px2+i-1, py2+i);
  629.           end;
  630.         end; { With menuparms do }
  631.       j_setcolor(old);
  632.       onscreen:=true;
  633.       end;
  634.  
  635.     constructor OHVMenu.Init;
  636.       var i:integer;
  637.       begin
  638.         HMenu.Init;
  639.         VMenu.Init;
  640.         {for i := 1 to MaxItems do VMenu.TArray[i]:='';}
  641.         HVResult := 0;
  642.         HResult  := 0;
  643.         VResult  := 0;
  644.         end; {contructor}
  645.  
  646.     destructor  OHVMenu.Done;
  647.       begin
  648.         HMenu.done;
  649.         VMenu.done;
  650.         end; {Destructor}
  651.  
  652.     procedure   OHVMenu.SetHorItems(
  653.       x1,y1,x2,y2,Nbg,NFg,HBg,HFg,Border,shadow,NumItems,Highlight:integer;
  654.       BordOn,ShadOn:boolean;AStr:string);
  655.       var menu:integer;
  656.       begin
  657.         menu:=0;
  658.         MenuArray[menu].menu:=0;
  659.         MenuArray[menu].x1:=x1;
  660.         MenuArray[menu].x2:=x2;
  661.         MenuArray[menu].y1:=y1;
  662.         MenuArray[menu].y2:=y2;
  663.         MenuArray[menu].NBg := NBg;
  664.         MenuArray[menu].NFg := NFg;
  665.         MenuArray[menu].HBg := HBg;
  666.         MenuArray[menu].HFg := HFg;
  667.         MenuArray[menu].Border:=Border;
  668.         MenuArray[menu].Shadow:=Shadow;
  669.         MenuArray[menu].BordOn:=BordOn;
  670.         MenuArray[menu].ShadOn:=ShadOn;
  671.         MenuArray[menu].AStr:=AStr;
  672.         end; {proc}
  673.  
  674.     procedure   OHVMenu.PutHParms(num:integer);
  675.       begin
  676.       with HMenu.MenuParms do begin
  677.         menu  := MenuArray[num].menu;
  678.         x1    := MenuArray[num].x1;
  679.         x2    := MenuArray[num].x2;
  680.         y1    := MenuArray[num].y1;
  681.         y2    := MenuArray[num].y2;
  682.         NBg   := MenuArray[num].NBg;
  683.         NFg   := MenuArray[num].NFg;
  684.         HBg   := MenuArray[num].HBg;
  685.         HFg   := MenuArray[num].HFg;
  686.         Border:= MenuArray[num].Border;
  687.         Shadow:= MenuArray[num].Shadow;
  688.         BordOn:= MenuArray[num].BordOn;
  689.         ShadOn:= MenuArray[num].ShadOn;
  690.         AStr  := MenuArray[num].AStr;
  691.  
  692.         px1   := MenuArray[num].x1 *CellWt-1;
  693.         px2   := MenuArray[num].x2 *CellWt-1;
  694.         py1   := MenuArray[num].y1 *CellHt-1;
  695.         py2   := MenuArray[num].y2 *CellHt-1;
  696.         if px1<0 then px1:=0;
  697.         if py1<0 then py1:=0;
  698.         if px2>HighX then px2:=HighX;
  699.         if py2>HighY then py2:=HighY;
  700.  
  701.         if px2+HMenu.ShadWt>HighX then HMenu.ShadWt:=HighX-px2;
  702.         if py2+HMenu.ShadWt>HighY then HMenu.ShadWt:=HighY-py2;
  703.         end;
  704.  
  705.       end;
  706.  
  707.     procedure   OHVMenu.SetVerItems(
  708.       menu,x1,y1,x2,y2,Nbg,NFg,HBg,HFg,Border,shadow,NumItems,Highlight:integer;
  709.       BordOn,ShadOn:boolean;AStr:string);
  710.       begin
  711.         MenuArray[menu].menu      :=menu;
  712.         MenuArray[menu].x1        :=x1;
  713.         MenuArray[menu].x2        :=x2;
  714.         MenuArray[menu].y1        :=y1;
  715.         MenuArray[menu].y2        :=y2;
  716.         MenuArray[menu].NBg       := NBg;
  717.         MenuArray[menu].NFg       := NFg;
  718.         MenuArray[menu].HBg       := HBg;
  719.         MenuArray[menu].HFg       := HFg;
  720.         MenuArray[menu].Border    :=Border;
  721.         MenuArray[menu].Shadow    :=Shadow;
  722.         MenuArray[menu].BordOn    :=BordOn;
  723.         MenuArray[menu].ShadOn    :=ShadOn;
  724.         MenuArray[menu].AStr      :=AStr;
  725.         end; {proc}
  726.  
  727.     procedure   OHVMenu.PutVParms(Num:integer);
  728.       begin
  729.       With VMenu.Menuparms do begin
  730.         menu     := MenuArray[num].menu;
  731.         x1       := MenuArray[num].x1;
  732.         x2       := MenuArray[num].x2;
  733.         y1       := MenuArray[num].y1;
  734.         y2       := MenuArray[num].y2;
  735.         NBg      := MenuArray[num].NBg;
  736.         NFg      := MenuArray[num].NFg;
  737.         HBg      := MenuArray[num].HBg;
  738.         HFg      := MenuArray[num].HFg;
  739.         Border   := MenuArray[num].Border;
  740.         Shadow   := MenuArray[num].Shadow;
  741.         BordOn   := MenuArray[num].BordOn;
  742.         ShadOn   := MenuArray[num].ShadOn;
  743.         AStr     := MenuArray[num].AStr;
  744.         px1   := MenuArray[num].x1 *CellWt-1;
  745.         px2   := MenuArray[num].x2 *CellWt-1;
  746.         py1   := MenuArray[num].y1 *CellHt-1;
  747.         py2   := MenuArray[num].y2 *CellHt-1;
  748.         if px1<0 then px1:=0;
  749.         if py1<0 then py1:=0;
  750.         if px2>HighX then px2:=HighX;
  751.         if py2>HighY then py2:=HighY;
  752.  
  753.         if px2+VMenu.ShadWt>HighX then VMenu.ShadWt:=HighX-px2;
  754.         if py2+VMenu.ShadWt>HighY then VMenu.ShadWt:=HighY-py2;
  755.         end;
  756.       end;
  757.     function    OHVMenu.GetHResult:shortint;
  758.       begin
  759.         GetHResult:=HMenu.Result;
  760.         end; {proc}
  761.  
  762.     function    OHVMenu.GetVResult:shortint;
  763.       begin
  764.         GetVResult:=VMenu.Result;
  765.         end; {proc}
  766.  
  767.     function    OHVMenu.GetHVResult:longint;
  768.       begin
  769.         GetHVResult:=
  770.           HMenu.Result * 100 + HMenu.Result;
  771.         end; {proc}
  772.  
  773.     function    OHVMenu.GetHChoice:shortint;
  774.       begin
  775.         GetHChoice:=hmenu.GetChoice;
  776.         end; {proc}
  777.  
  778.     function    OHVMenu.GetVChoice:shortint;
  779.       begin
  780.         GetVChoice:=vmenu.GetChoice;
  781.         end; {proc}
  782.  
  783.     function    OHVMenu.GetHVChoice:longint;
  784.       begin
  785.         GetHVChoice:=
  786.           hmenu.GetChoice * 100 + VMenu.GetChoice;
  787.         end; {proc}
  788.  
  789.     procedure  OHVMenu.UseMenu;
  790.       var Quit : boolean;
  791.       begin
  792.         Quit:=false;
  793.         PutHParms(0);
  794.         While (not quit) or (Vmenu.GetChoice<1)   do begin
  795.           if HMenu.Menuparms.Highlight <1 then
  796.             HMenu.Menuparms.Highlight := HMenu.MenuParms.NumItems;
  797.           if HMenu.Menuparms.Highlight > HMenu.MenuParms.NumItems then
  798.             HMenu.Menuparms.Highlight:=1;
  799.           HMenu.Result:=0;
  800.           while HMenu.Result in [0,LfArrow,RtArrow] do
  801.             HMenu.UseMenu(1);
  802.           Quit:=(HMenu.Result=Escape);
  803.           if not quit then begin
  804.             VMenu.Result:=0;
  805.             while VMenu.Result in [0,DnArrow,UpArrow] do begin
  806.               putVParms(HMenu.GetChoice);
  807.               VMenu.UseMenu(HMenu.GetChoice);
  808.               VMenu.EraseMenu;
  809.               end; {while vmenu}
  810.             Quit:=(VMenu.Result=Escape)or(VMenu.Result=Enter);
  811.             end; {if not quit}
  812.           if not quit then begin
  813.             if VMenu.Result=LfArrow then dec(HMenu.Menuparms.Highlight);
  814.             if VMenu.Result=RtArrow then inc(HMenu.Menuparms.Highlight);
  815.             end; {if not quit}
  816.           end; {while not quit or vemenu.getchoice<1 }
  817.         if VMenu.Eraseok then VMenu.Erasemenu;
  818.         if HMenu.Eraseok then HMenu.Erasemenu;
  819.         {VMenu.done;
  820.         HMenu.done;}
  821.         end; {proc}
  822.     function OHVMenu.MenuResult(EraseH,EraseV:boolean):integer;
  823.       var Quit : boolean;
  824.       begin
  825.         Quit:=false;
  826.         PutHParms(0);
  827.         While not quit do begin
  828.           {((not quit) or (Vmenu.GetChoice<1))}
  829.           if HMenu.Menuparms.Highlight <1 then
  830.             HMenu.Menuparms.Highlight := HMenu.MenuParms.NumItems;
  831.           if HMenu.Menuparms.Highlight > HMenu.MenuParms.NumItems then
  832.             HMenu.Menuparms.Highlight:=1;
  833.           HMenu.Result:=0;
  834.           while HMenu.Result in [0,LfArrow,RtArrow] do
  835.             HMenu.UseMenu(1);
  836.           Quit:=(HMenu.Result=Escape);
  837.           if not quit then begin
  838.             VMenu.Result:=0;
  839.             while VMenu.Result in [0,DnArrow,UpArrow] do begin
  840.               putVParms(HMenu.GetChoice);
  841.               VMenu.UseMenu(HMenu.GetChoice);
  842.               VMenu.EraseMenu;
  843.               end; {while vmenu}
  844.             Quit:=(VMenu.Result=Escape)or(VMenu.Result=Enter);
  845.             end; {if not quit}
  846.           if not quit then begin
  847.             if VMenu.Result=LfArrow then dec(HMenu.Menuparms.Highlight);
  848.             if VMenu.Result=RtArrow then inc(HMenu.Menuparms.Highlight);
  849.             end; {if not quit}
  850.           end; {while not quit}
  851.         if EraseV then VMenu.Erasemenu;
  852.         if EraseH then HMenu.Erasemenu;
  853.         MenuResult:=VMenu.GetChoice + (HMenu.GetChoice*100);
  854.         end; {proc}
  855. end.
  856.